;;; test-set.ss  -- Jens Axel Soegaard

(require (lib "plt-pretty-big-text.ss" "lang")
         "test-harness.ss"
         "../set.ss")

(print-tests #t)

(define (integer-test set@)
  (use-set set@)
  
  (define A (set 1 2 3))
  (define B (set 3 4 5))
  
  (define (test/sort result expected)
    (test (mergesort result <) (mergesort expected <)))
  
  (let ([A (set 1 2 3 3)]
        [B (set 3 4 5)])
    (test (empty? empty))
    (test/sort (elements (union A B)) '(1 2 3 4 5))
    (test/sort (elements (difference A B))   '(1 2))
    (test/sort (elements (intersection A B)) '(3))
    (test (not (empty? A)))
    (test (member? B 5))
    (test (not (member? B 7)))
    (test (subset? (set 1 2 2 3) (set 1 1 2 2 2 3)))
    (test (not (subset? (set 1 2 3) (set 1 2))))
    (test (subset? (set 1 1 2) (set 1 2)))
    (test/sort (elements (set 1 2 3)) (elements (set 2 1 3)))
    (test/sort (elements (set 1 2 3)) (elements (insert (set 1 3) 2)))
    (test/sort (elements (set 1))     (elements (remove-all (set 1 2 2 3 4) '(3 2 4))))
    (test/sort (elements (set 1 2))   (elements (remove (set 1 3 2) 3)))
    (test (size (set 1 2 3 3)) 3)
    (test (size (remove (set 1 2 3) 7)) 3)
    (test/sort (elements (set 1 1 2 3 3)) '(1 2 3))
    (test (member? (set 1 3 4 2) 3))
    (test (not (member? (set 1 3 4 2) 5)))
    (test (fold + 0 (set 1 2 3 4 5 6 7 8 9)) 45)
    (void)))

(define (string-test string-set@)
  (use-set string-set@)
  
  (define A (set "1" "2" "3"))
  (define B (set "3" "4" "5"))
  
  (define (test/sort result expected)
    (test (mergesort result string<?) (mergesort expected string<?)))
  
  (let ([A (set "1" "2" "3" "3")]
        [B (set "3" "4" "5")])
    (test (empty? empty))
    (test/sort (elements (union A B))        '("1" "2" "3" "4" "5"))
    (test/sort (elements (difference A B))   '("1" "2"))
    (test/sort (elements (intersection A B)) '("3"))
    (test (not (empty? A)))
    (test (member? B "5"))
    (test (not (member? B "7")))
    (test (subset? (set "1" "2" "2" "3") (set "1" "1" "2" "2" "2" "3")))
    (test (not (subset? (set "1" "2" "3") (set "1" "2"))))
    (test (subset? (set "1" "1" "2") (set "1" "2")))
    (test/sort (elements (set "1" "2" "3")) (elements (set "2" "1" "3")))
    (test/sort (elements (set "1" "2" "3")) (elements (insert (set "1" "3") "2")))
    (test/sort (elements (set "1"))     (elements (remove-all (set "1" "2" "2" "3" "4") '("3" "2" "4"))))
    (test/sort (elements (set "1" "2"))   (elements (remove (set "1" "3" "2") "3")))
    (test (size (set "1" "2" "3" "3")) 3)
    (test (size (remove (set "1" "2" "3") "7")) 3)
    (test/sort (elements (set "1" "1" "2" "3" "3")) '("1" "2" "3"))
    (test (member? (set "1" "3" "4" "2") "3"))
    (test (not (member? (set "1" "3" "4" "2") "5")))
    (void)))



;;; INTEGER TEST

'test-ordered-list-set--integers
(integer-test (instantiate-set ordered-list-set@ integers@))

'test-unordered-list-set--integers
(integer-test (instantiate-set unordered-list-set@ =))

'test-unbalanced-bst-set--integers
(integer-test (instantiate-set unbalanced-search-tree-set@ integers@))

'test-randomized-binary-search-tree-set--integers
(integer-test (instantiate-set randomized-binary-search-tree-set@ integers@))

'test-red-black-tree-set--integers
(integer-test (instantiate-set red-black-tree-set@ integers@))


'test-weight-balanced-trees--integers
(integer-test (instantiate-set weight-balanced-tree-set@ integers@))

;;; STRING TEST
#;(
'test-ordered-list-set--strings
(string-test (instantiate-set ordered-list-set@ strings@))

'test-unordered-list-set--strings
(string-test (instantiate-set unordered-list-set@ string=?))

'test-unbalanced-bst-set--strings
(string-test (instantiate-set unbalanced-search-tree-set@ strings@))

'test-randomized-binary-search-tree-set--strings
(string-test (instantiate-set randomized-binary-search-tree-set@ strings@))

'test-red-black-tree-set--strings
(string-test (instantiate-set red-black-tree-set@ strings@))
)
'test-weight-balanced-trees--strings
(string-test (instantiate-set weight-balanced-tree-set@ strings@))

;; COLLISION TEST

(define collision-order@
  (unit/sig ordered^
    (import)
    (define elm=   =)
    (define (elm<  a b) (<  (modulo a 2) (modulo b 2)))
    (define (elm<= a b) (<= (modulo a 2) (modulo b 2)))))



'collision-test-ordered-list-set--integers
(integer-test (instantiate-set ordered-list-set@ collision-order@))

'collision-test-unbalanced-bst-set--integers
(integer-test (instantiate-set unbalanced-search-tree-set@ collision-order@))
  
'collision-test-red-black-tree-set--integers
(integer-test (instantiate-set red-black-tree-set@ collision-order@))

#|  
'collision-test-randomized-binary-search-tree-set--integers
(integer-test (instantiate-set randomized-binary-search-tree-set@ collision-order@))
  
'collision-test-weight-balanced-trees--integers
(integer-test (instantiate-set weight-balanced-tree-set@ collision-order@))
|#